home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD Fun House 1
/
CD Fun House (Wayzata Technology).iso
/
•Word Games•
/
WordFind •••
/
Source
/
placeword
next >
Wrap
Text File
|
1987-11-14
|
7KB
|
329 lines
UNIT placepuzzle;
INTERFACE
USES
stringf;
CONST
MAXX = 30;
MAXY = 30;
TYPE
cell = RECORD
ch : char;
boldf : boolean;
END;
cmat = ARRAY[1..MAXX, 1..MAXY] OF cell;
VAR
XMAX : integer;
YMAX : integer;
puzzle : cmat;
FUNCTION randnum (x : integer) : integer;
FUNCTION rightlen (word : STRING) : boolean;
FUNCTION placerandom (word : STRING) : boolean;
FUNCTION placeanyplace (word : STRING) : boolean;
IMPLEMENTATION
TYPE
location = RECORD
x : integer;
y : integer;
END;
crose = (north, south, east, west, northeast, northwest, southeast, southwest);
compass = SET OF crose;
randrec = RECORD
xp, yp : integer;
dir : crose;
incx, incy : integer; {used to check fit}
END;
VAR
rrec : randrec;
FUNCTION randnum;
{ returns a random number between x and 1 }
VAR
y, z : real;
BEGIN
y := abs(Random);
z := (y / 32768.0);
randnum := integer(trunc(x * z)) + 1;
END;
PROCEDURE getinc (VAR x, y : integer;
d : crose);
BEGIN
CASE d OF
north, south :
BEGIN
y := 1;
x := 0;
END;
east, west :
BEGIN
y := 0;
x := 1;
END;
northeast, southwest :
BEGIN
x := -1;
y := 1;
END;
northwest, southeast :
BEGIN
x := 1;
y := 1;
END;
END;
END;
PROCEDURE getrand (VAR r : randrec);
VAR
xi, yi : integer;
BEGIN
r.xp := randnum(XMAX);
r.yp := randnum(YMAX);
CASE randnum(8) OF
1 :
r.dir := north;
2 :
r.dir := south;
3 :
r.dir := east;
4 :
r.dir := west;
5 :
r.dir := northeast;
6 :
r.dir := northwest;
7 :
r.dir := southeast;
8 :
r.dir := southwest;
END;
getinc(xi, yi, r.dir);
r.incx := xi;
r.incy := yi;
END;
FUNCTION placerandom;
VAR
backwords : SET OF crose;
i, j, k, x, y : integer;
len : integer;
ok : boolean;
BEGIN
len := length(word);
backwords := [east, north, northeast, southeast];
ok := true;
getrand(rrec);
IF rrec.dir IN backwords THEN
wreverse(word);
CASE rrec.dir OF
north, south :
BEGIN
IF YMAX - rrec.yp + 1 < len THEN
ok := false;
END;
east, west :
BEGIN
IF XMAX - rrec.xp + 1 < len THEN
ok := false;
END;
northwest, southeast :
BEGIN
IF (XMAX - rrec.xp + 1 < len) OR (YMAX - rrec.yp + 1 < len) THEN
ok := false;
END;
northeast, southwest :
BEGIN
IF (rrec.xp < len) OR (YMAX - rrec.yp + 1 < len) THEN
ok := false;
END;
END;
IF ok = true THEN
{it has now passed the first test}
BEGIN
x := rrec.xp; (* set up the pointers *)
y := rrec.yp;
i := 1;
WHILE ((puzzle[x, y].ch = ' ') OR (puzzle[x, y].ch = word[i])) AND (i < len) DO
BEGIN
x := x + rrec.incx;
y := y + rrec.incy;
i := i + 1;
END;
IF (i = len) AND ((puzzle[x, y].ch = word[i]) OR (puzzle[x, y].ch = ' ')) THEN
(* we made it!!! The word fits into the puzzle; put it in!!!*)
BEGIN
ok := true;
x := rrec.xp;
y := rrec.yp;
FOR i := 1 TO len DO
BEGIN
puzzle[x, y].ch := word[i];
puzzle[x, y].boldf := true;
x := x + rrec.incx;
y := y + rrec.incy;
END;
END
ELSE
ok := false;
END;
placerandom := ok;
END;
FUNCTION rightlen; (* will the word fit on the screen?*)
BEGIN
IF (length(word) > XMAX) AND (length(word) > YMAX) THEN
rightlen := false
ELSE
rightlen := true;
END;
{}
{This routine will do anything to get a word into the puzzle}
FUNCTION placeanyplace; (* get it in there anyway you have to*)
CONST
NUMDIR = 8;
LABEL
100;
VAR
pword : STRING;
ok : boolean; (*this is used to get us out of the loop*)
xi, yi, lcount, len, x, y : integer;
incx, incy : integer;
backwords : SET OF crose;
dirset, dirarray : ARRAY[1..NUMDIR] OF integer;
dirptr : integer;
whichway : crose;
dircount : integer;
PROCEDURE setrandlist;
VAR
i, j : integer;
rdir : integer;
d : crose;
num : integer;
BEGIN
FOR i := 1 TO NUMDIR DO { create array of possible values }
dirset[i] := i;
FOR i := 1 TO NUMDIR DO { pick one at random and assign it to a slot in dirarray}
BEGIN
IF i < NUMDIR THEN
rdir := randnum(NUMDIR - i + 1)
ELSE
rdir := 1;
dirarray[i] := dirset[rdir];
IF i <> NUMDIR THEN
FOR j := rdir TO NUMDIR - i DO
dirset[j] := dirset[j + 1];
END;
dirptr := 1;
END;
FUNCTION getdir : crose;
VAR
dircnt, d : crose;
i : integer;
BEGIN
IF dirarray[dirptr] = 1 THEN
getdir := north
ELSE
BEGIN
d := north;
FOR i := 1 TO dirarray[dirptr] - 1 DO
d := succ(d); (* bump up direction*)
getdir := d;
END;
IF dirptr < NUMDIR THEN
dirptr := dirptr + 1;
END;
BEGIN
setrandlist;
backwords := [east, north, northeast, southeast];
dircount := 1;
whichway := getdir;
len := length(word);
xi := 1;
yi := 1;
REPEAT
ok := true;
pword := word;
IF whichway IN backwords THEN
wreverse(pword);
getinc(incx, incy, whichway);
(**)
(*Will this fit in the spot we have chosen?*)
(**)
CASE whichway OF
north, south :
BEGIN
IF YMAX - yi + 1 < len THEN
ok := false;
END;
east, west :
BEGIN
IF XMAX - xi + 1 < len THEN
ok := false;
END;
northwest, southeast :
BEGIN
IF (XMAX - xi + 1 < len) OR (YMAX - yi + 1 < len) THEN
ok := false;
END;
northeast, southwest :
BEGIN
IF (xi < len) OR (YMAX - yi + 1 < len) THEN
ok := false;
END;
END; {end case}
IF ok = true THEN
{it has now passed the first test}
{there is room for it}
BEGIN
x := xi; (* set up the pointers *)
y := yi;
lcount := 1;
WHILE ((puzzle[x, y].ch = ' ') OR (puzzle[x, y].ch = word[lcount])) AND (lcount < len) DO
BEGIN
x := x + incx;
y := y + incy;
lcount := lcount + 1;
END;
IF ((lcount = len) AND (puzzle[x, y].ch = word[lcount])) OR ((lcount = len) AND (puzzle[x, y].ch = ' ')) THEN
(* we made it!!! The word fits into the puzzle; put it in!!!*)
BEGIN
ok := true;
x := xi;
y := yi;
FOR lcount := 1 TO len DO
BEGIN
puzzle[x, y].ch := word[lcount];
puzzle[x, y].boldf := true;
x := x + incx;
y := y + incy;
END; {end for}
END {end if}
{ didn't fit in the space}
ELSE
ok := false;
END
ELSE
ok := false;
IF (ok = false) THEN
IF xi = XMAX THEN
IF yi <> YMAX THEN {are we at the end of a line}
BEGIN
xi := 1; { move to the beginning}
yi := yi + 1; {and bump up y}
END
ELSE IF dircount <> NUMDIR THEN
BEGIN
whichway := getdir;
dircount := dircount + 1;
END
ELSE
GOTO 100 {get out of here we have failed}
ELSE IF (ok = false) AND (xi < XMAX) THEN
xi := xi + 1;
UNTIL (ok = true);
100 :
placeanyplace := ok;
END;
END.
